perm filename DIFB[M11,LCS] blob
sn#374003 filedate 1978-08-02 generic text, type T, neo UTF8
1) M11B.F4[M11,LCS] and 2) M11B.F4[P11,LCS] 8-02-78 12:40 pages 1,1
**** File 1) M11B.F4[M11,LCS], Page 1 line 1
1) COMMENT ā VALID 00002 PAGES
1) C REC PAGE DESCRIPTION
1) C00001 00001
1) C00002 00002 CGEN1 FUNCTION GENERATOR 1
1) C00011 ENDMK
1) Cā;
1) CGEN1 FUNCTION GENERATOR 1
**** File 2) M11B.F4[P11,LCS], Page 1 line 1
2) CGEN1 FUNCTION GENERATOR 1
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 5
1) COMMON I(1)/P/ P(1) /GENS/IGN(1)
1) 1 /LFUNC/LFUNC
1) N1=1+(IFIX(P(4))-1)*LFUNC
1) M1=7
1) 102 M=M1+1
1) IF(P(M).LE.0)GO TO 103
1) V1=P(M1-2)
1) V2=(P(M1)-P(M1-2))/(P(M)-P(M1-1))
1) MA=N1+IFIX(P(M1-1))
1) MB=N1+IFIX(P(M))-1
1) DO 101 J=MA,MB
1) XJ=J-MA
1) 101 IGN(J)=V1+V2*XJ
1) IF(IFIX(P(M)).EQ.(LFUNC-1))GO TO 103
1) M1=M1+2
**** File 2) M11B.F4[P11,LCS], Page 1 line 5
2) COMMON I(1)/P/ P(1)/PARM/IP(1) /GENS/IGN(1)
2) N1=1+(IFIX(P(4))-1)*IP(6)
2) M1=7
2) 102 IF(P(M1+1))103,103,100
2) 100 V1=P(M1-2)
2) V2=(P(M1)-P(M1-2))/(P(M1+1)-P(M1-1))
2) MA=N1+IFIX(P(M1-1))
2) MB=N1+IFIX(P(M1+1))-1
2) DO 101J=MA,MB
2) XJ=J-MA
2) 101 IGN(J)=V1+V2*XJ
2) IF(IFIX(P(M1+1)).EQ.(IP(6)-1))GO TO 103
2) M1=M1+2
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 29
1) COMMON I(1)/P/ P(1) /GENS/IGN(1)
1) M11B.F4[M11,LCS] and 2) M11B.F4[P11,LCS] 8-02-78 12:40 pages 2,1
1) 1 /LFUNC/LFUNC
1) N1=1+(IFIX(P(4))-1)*LFUNC
1) N2=N1+LFUNC-1
1) DO 101 K1=N1,N2
1) 101 IGN(K1)=0.0
1) FAC=6.283185/(FLOAT(LFUNC)-1.0)
1) NMAX=I(1)
1) N3=5+INT(ABS(P(NMAX)))-1
1) IF(N3-5.LT.0)GO TO 104
1) DO 103 J=5,N3
1) FACK=FAC*FLOAT(J-4)
1) DO 102 K=N1,N2
1) 102 IGN(K)=IGN(K)+SIN(FACK*FLOAT(K-N1))*P(J)
**** File 2) M11B.F4[P11,LCS], Page 1 line 27
2) COMMON I(1)/P/ P(1)/PARM/IP(1) /GENS/IGN(1)
2) N1=1+(IFIX(P(4))-1)*IP(6)
2) N2=N1+IP(6)-1
2) DO 101K1=N1,N2
2) 101 IGN(K1)=0.0
2) FAC=6.283185/(FLOAT(IP(6))-1.0)
2) NMAX=I(1)
2) N3=5+INT(ABS(P(NMAX)))-1
2) IF(N3-5)104,100,100
2) 100 DO 103J=5,N3
2) FACK=FAC*FLOAT(J-4)
2) DO 102K=N1,N2
2) 102 IGN(K)=IGN(K)+SIN(FACK*FLOAT(K-N1))*P(J)
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 46
1) IF(N5-N4.LT.0)GO TO 114
1) DO 107 J1=N4,N5
1) FACK=FAC*FLOAT(J1-N4)
**** File 2) M11B.F4[P11,LCS], Page 1 line 43
2) IF(N5-N4)114,105,105
2) 105 DO 107J1=N4,N5
2) FACK=FAC*FLOAT(J1-N4)
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 52
1) 114 IF(P(NMAX).LE.0)GO TO 112
1) FMAX=0.0
1) DO 110 K2=N1,N2
1) A=ABS(IGN(K2))
1) 110 IF(FMAX.LT.A)FMAX=A
1) 113 DO 111 K3=N1,N2
1) M11B.F4[M11,LCS] and 2) M11B.F4[P11,LCS] 8-02-78 12:40 pages 2,1
**** File 2) M11B.F4[P11,LCS], Page 1 line 49
2) 114 CONTINUE
2) IF(P(NMAX))112,112,108
2) 108 FMAX=0.0
2) DO 110 K2=N1,N2
2) IF(ABS(IGN(K2))-FMAX)110,110,109
2) 109 FMAX=ABS(IGN(K2))
2) 110 CONTINUE
2) 113 DO 111 K3=N1,N2
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 83
1) CS BLOCK DATA
1) CS COMMON /PARM/IP(20)
1) CS DATA IP/12,512,10000, 7100, 7000,512, 6000,35,27,4487,2048,
1) CS 1 10 ,4487,512, "77777 ,5*0/
1) CCC DATA IP/12,512,10000,14500,14400,512,13000,35,40,6657,2048,
**** File 2) M11B.F4[P11,LCS], Page 1 line 82
2) BLOCK DATA
2) COMMON /PARM/IP(20)
2) DATA IP/12,512,10000, 7100, 7000,512, 6000,35,27,4487,2048,
2) 1 10 ,4487,512, "77777 ,5*0/
2) CCC DATA IP/12,512,10000,14500,14400,512,13000,35,40,6657,2048,
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 90
1) CS END
1) SUBROUTINE FROUT3(IDSK)
1) C TERMINATE OUTPUT
1) CSS INTEGER PEAK
1) REAL IOUT
1) COMMON /IOUT/IOUT(1) /FINOUT/PEAK /CONV/CONV
1) DO 1 K=1,512
**** File 2) M11B.F4[P11,LCS], Page 1 line 89
2) END
2) SUBROUTINE FROUT3(IDSK)
2) C TERMINATE OUTPUT
2) INTEGER PEAK
2) REAL IOUT
2) COMMON /IOUT/IOUT(1) /FINOUT/PEAK,NRSOR /CONV/CONV
2) DO 1 K=1,512
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 101
1) IF(CONV.EQ.0)CALL EXIT
1) M11B.F4[M11,LCS] and 2) M11B.F4[P11,LCS] 8-02-78 12:40 pages 2,1
1) CALL FINFIL
1) TYPE 2
1) 2 FORMAT(' 11.DMD WAS WRITTEN ********')
1) CALL EXIT
1) 10 FORMAT ('0PEAK AMPLITUDE WAS ',F7.0)
1) CSS 10 FORMAT ('0PEAK AMPLITUDE WAS ',I6)
1) END
**** File 2) M11B.F4[P11,LCS], Page 1 line 100
2) CC TYPE 10,PEAK,NRSOR
2) IF(CONV.EQ.0)CALL FINFIL
2) CALL EXIT
2) 10 FORMAT ('0PEAK AMPLITUDE WAS ',I6)
2) CC 10 FORMAT ('0PEAK AMPLITUDE WAS',I8/'0NUMBER OF SAMPLES OUT OF RANGE
2) CC 1WAS',I8)
2) END
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 116
1) COMMON I(1) /IOUT/IOUT(1) /FINOUT/PEAK,IPEAK,NBUF
1) 1 /CONV/CONV,INIOUT,JFLNM
1) DIMENSION IDBUF(2048),JDBUF(512),NN(512),LDBUF(512)
1) EQUIVALENCE (IDBUF,JDBUF),(LDBUF,IDBUF(513))
1) C*** IDBUF WILL STORE PACKED SAMPLES. ****
1) CSS INTEGER PEAK
1) IF(INIOUT.EQ.0)GO TO 99
1) C NOW OPEN PROPER OUTPUT FILE
1) INIOUT=0
1) IDSK=0
1) IF(CONV.EQ.0)GO TO 199
1) CALL PUTFILE('11')
1) NN(1)="525252525252
1) NN(2)=I(4)
1) C I(4)=SRATE, I(8)=NCHNS(-1), FOR NEXT, 18 BIT SMPLS.
1) NN(3)=1
1) NN(4)=I(8)+1
1) NN(5)=33000
1) DO 299 K=6,128
1) 299 NN(K)=0
1) CALL FASTOU(NN,128)
1) GO TO 99
1) C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
1) CX199X CALL OPEN(23,'TEST',0,'NEW',,,'UNF')
1) 199 CALL OFILE(23,'TEST')
1) 99 J=IDSK+1
**** File 2) M11B.F4[P11,LCS], Page 1 line 114
2) COMMON /IOUT/IOUT(1) /PARM/IP(1)/FINOUT/PEAK,NRSOR,IPEAK
2) 1 /CONV/CONV
1) M11B.F4[M11,LCS] and 2) M11B.F4[P11,LCS] 8-02-78 12:40 pages 2,1
2) DIMENSION IDBUF(1023),JDBUF(512),NN(256)
2) EQUIVALENCE (IDBUF,JDBUF)
2) C*** IDBUF WILL STORE PACKED SAMPLES. ****
2) INTEGER PEAK
2) 99 J=IDSK+1
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 147
1) S=IOUT(M1+M2)
1) A=ABS(S)
1) IF(A.GT.PEAK)PEAK=A
1) IF(CONV.NE.0)S=S*32.
1) C *32 TO CONVERT 12 BIT AMPL RANGE TO 16 BIT RANGE.
1) IDBUF(K)=S
1) 1 M2=M2+1
1) IF(IDSK.LT.NBUF)RETURN
1) C NBUF=512,MONO =1024,STEREO
1) IF(CONV.EQ.0)GO TO 11
1) M=1
1) J=NBUF/2
1) DO 44 K=1,J
1) NN(K)=IDBUF(M)*262144+IDBUF(M+1)
1) C 16*262144=4194304
**** File 2) M11B.F4[P11,LCS], Page 1 line 126
2) N1=IOUT(M1+M2)
2) J=IABS(N1)
2) IF(J.GT.PEAK)PEAK=J
2) IDBUF(K)=N1
2) 1 M2=M2+1
2) IF(IDSK.LT.512)RETURN
2) IF(CONV)GO TO 11
2) M=1
2) DO 44 K=1,256
2) NN(K)=IDBUF(M)*4194304+IDBUF(M+1)*16
2) C 16*262144=4194304
***************
**** File 1) M11B.F4[M11,LCS], Page 2 line 169
1) CALL FASTOU(NN,J)
1) GO TO 10
1) 11 WRITE(23)JDBUF
1) IF(NBUF.NE.512)WRITE(23),LDBUF
1) C ABOVE FOR STEREO
1) 10 J=IDSK-NBUF
1) IF(J.LT.1)GO TO 4
1) DO 5 K=1,J
1) M11B.F4[M11,LCS] and 2) M11B.F4[P11,LCS] 8-02-78 12:40 pages 2,1
1) 5 IDBUF(K)=IDBUF(NBUF+K)
1) 4 IDSK=J
**** File 2) M11B.F4[P11,LCS], Page 1 line 144
2) CALL FASTOU(NN,256)
2) GO TO 10
2) 11 WRITE(23)JDBUF
2) 10 J=IDSK-512
2) IF(J.LT.1)GO TO 4
2) DO 5 K=1,J
2) 5 IDBUF(K)=IDBUF(512+K)
2) 4 IDSK=J
***************